home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fritz: All Fritz
/
All Fritz.zip
/
All Fritz
/
FILES
/
PROGASIC
/
BASFILES.LZH
/
HMSKINPT.BAS
< prev
next >
Wrap
BASIC Source File
|
1988-09-10
|
7KB
|
289 lines
'$INCLUDE:'QBTOOLS.INC'
'' '$INCLUDE: 'qbtools2.inc'
SUB hMaskInput (hB AS Hbuffer, Allowup%, Allowpu%, Allowdn%, Allowpd%, Allowrt%, Allowtb%, Allowes%, il%, St$, Xc%, Yc%, fc%, Bc%, UpperCaseFlag%, ExitKey%, Mask$) STATIC
CONST MASKVALUES = "()-/\[]{}:<>.=+;,?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz "
InsStatus% = 0 ' Insert flag
IF LEN(St$) > il% THEN ' String is already too long
St$ = MID$(St$, 1, il%) ' Make it the right size
END IF
IF LEN(St$) < il% THEN ' MUST make it equal to BLANKS
St$ = St$ + STRING$(il% - LEN(St$), 32)
END IF
IF LEN(Mask$) <> il% THEN
ExitKey% = 0
EXIT SUB
END IF
InChar% = 0
FOR j% = 1 TO il%
InChar% = InChar% + ABS(INSTR(MASKVALUES, MID$(Mask$, j%, 1)) > 0)
NEXT j%
IF InChar% = il% THEN
EXIT SUB
END IF
FOR j% = 1 TO il%
ch$ = MID$(Mask$, j%, 1)
SELECT CASE ch$
CASE "(", ")", "-", "/", "\", "[", "]", "{", "}", ":", "<", ">", ".", "=", "+", ";", ",", "?", "A" TO "Z", "a" TO "z", " "
MID$(St$, j%, 1) = ch$
CASE ELSE
END SELECT
NEXT j%
MaskBackup$ = St$
Xoff% = 1 ' X-co-ordinate offset
Attr% = Attributes%(fc%, Bc%, 0, 0)
ExitKey% = 0
ColorPrint St$, Yc%, Xc%, Attr%
DO ' Until there's an exit
DO
IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) THEN
Xoff% = Xoff% + 1
ELSE
EXIT DO
END IF
IF Xoff% > il% THEN
Xoff% = il%
DO
IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) THEN
Xoff% = Xoff% - 1
ELSE
EXIT DO
END IF
LOOP
END IF
LOOP
IF Xoff% > il% THEN ' Cursor positioner too long
Xoff% = il%
END IF
IF Xoff% < 1 THEN
Xoff% = 1
END IF
ColorPrint St$, Yc%, Xc%, Attr%
IF InsStatus% = 1 THEN ' Insert is on
LOCATE Yc%, Xc% + Xoff% - 1, 1, 0, 15
ELSE
LOCATE Yc%, Xc% + Xoff% - 1, 1, 7, 7
END IF
w$ = "" ' Wait until there's a character
WHILE w$ = ""
w$ = INKEY$
WEND
LOCATE , , 0
IF LEN(w$) = 1 THEN ' Normal character
Test$ = MID$(Mask$, Xoff%, 1)
ch% = ASC(w$)
IF ch% = 13 THEN
IF Allowrt% = 1 THEN ' Yes, return is ok
ExitKey% = 5
EXIT DO
END IF
END IF
IF ch% = 9 THEN
IF Allowtb% = 1 THEN ' Yes, TAB is ok
ExitKey% = 6
EXIT DO
END IF
END IF
IF ch% = 27 THEN
IF Allowes% = 1 THEN ' Yes, ESC is ok
ExitKey% = 7
EXIT DO
END IF
END IF
IF Test$ >= "0" AND Test$ <= "9" THEN
IF w$ <= Test$ THEN
ch% = ASC(w$)
ELSE
ch% = 0
END IF
END IF
IF Test$ = "&" THEN
IF UCASE$(w$) >= "A" AND UCASE$(w$) <= "Z" OR w$ = " " THEN
ch% = ASC(w$)
ELSE
ch% = 0
END IF
END IF
SELECT CASE ch%
CASE 32 TO 126 ' Normal displayable char
IF UpperCaseFlag% = 1 THEN ' Make it upper
w$ = UCASE$(w$)
ch% = ASC(w$)
END IF
IF UpperCaseFlag% = 2 THEN ' Make it lower
w$ = LCASE$(w$)
ch% = ASC(w$)
END IF
MID$(St$, Xoff%, 1) = CHR$(ch%)
Xoff% = Xoff% + 1
CASE 8, 127 ' Back space
IF Xoff% > 1 THEN
Xoff% = Xoff% - 1
IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) = 0 THEN
MID$(St$, Xoff%, 1) = " "
END IF
DO
IF Xoff% > 0 THEN
IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) THEN
Xoff% = Xoff% - 1
ELSE
MID$(St$, Xoff%, 1) = " "
EXIT DO
END IF
ELSE
EXIT DO
END IF
LOOP
IF Xoff% = 0 THEN
DO
Xoff% = Xoff% + 1
IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) = 0 THEN
EXIT DO
ELSE
IF Xoff% = il% THEN
PRINT
PRINT "Illegal Mask"
PRINT
END
END IF
END IF
LOOP
END IF
END IF
CASE ELSE
END SELECT
ELSE
ch% = ASC(MID$(w$, 2)) ' Extended character
SELECT CASE ch%
CASE 59, 84, 94, 104 ' Function Key One
hFrameHandler hB ' Call the Help Handler
CASE 75 ' Left arrow
IF Xoff% > 1 THEN
Xoff% = Xoff% - 1
DO
IF Xoff% > 0 THEN
IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) THEN
Xoff% = Xoff% - 1
ELSE
EXIT DO
END IF
ELSE
EXIT DO
END IF
LOOP
IF Xoff% = 0 THEN
DO
Xoff% = Xoff% + 1
IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) = 0 THEN
EXIT DO
ELSE
IF Xoff% = il% THEN
PRINT
PRINT "Illegal Mask"
PRINT
END
END IF
END IF
LOOP
END IF
END IF
CASE 77 ' Right arrow
Xoff% = Xoff% + 1
CASE 71 ' Home
Xoff% = 1
CASE 79 ' End
Xoff% = il%
CASE 82 ' Insert
InsStatus% = 1 - InsStatus%
CASE 83 ' Delete
IF INSTR(MASKVALUES, MID$(Mask$, Xoff%, 1)) = 0 THEN
MID$(St$, Xoff%, 1) = " "
END IF
CASE 72 ' Up arrow
IF Allowup% = 1 THEN ' Yes, UP is ok
ExitKey% = 1
EXIT DO
END IF
CASE 73 ' Page up
IF Allowpu% = 1 THEN ' Yes, PAGE UP is ok
ExitKey% = 2
EXIT DO
END IF
CASE 81 ' Page down
IF Allowpd% = 1 THEN ' Yes, PAGE DOWN is ok
ExitKey% = 4
EXIT DO
END IF
CASE 80 ' Down arrow
IF Allowdn% = 1 THEN ' Yes, DOWN is ok
ExitKey% = 3
EXIT DO
END IF
CASE 32 ' ALT+D (Delete)
St$ = MaskBackup$
Xoff% = 1
CASE ELSE
END SELECT
END IF
LOOP WHILE ExitKey% = 0
END SUB